home *** CD-ROM | disk | FTP | other *** search
/ Almathera Ten Pack 2: CDPD 1 / Almathera Ten on Ten - Disc 2: CDPD 1.iso / pd / 101-125 / 118 / empire / src / source.zoo / fileio.d < prev    next >
Text File  |  1987-12-02  |  18KB  |  761 lines
  1. #include:util.g
  2. #empire.g
  3. #empfunc.g
  4.  
  5. uint
  6.     OS_BLOCK_SIZE = 512 - 4 * 6,
  7.     SECTOR_CACHE_SIZE = 100,
  8.     SHIP_CACHE_SIZE = 100;
  9.  
  10. type
  11.     SectorCache_t = struct {
  12.     *SectorCache_t sc_next, sc_prev;    /* next, prev in LRU chain */
  13.     bool sc_dirty;                /* needs writing to disk */
  14.     ushort sc_row, sc_col;            /* absolute co-ords */
  15.     Sector_t sc_sector;            /* the sector data */
  16.     },
  17.  
  18.     ShipCache_t = struct {
  19.     *ShipCache_t shc_next, shc_prev;
  20.     bool shc_dirty;
  21.     uint shc_shipNumber;
  22.     Ship_t shc_ship;
  23.     };
  24.  
  25. [SECTOR_CACHE_SIZE] SectorCache_t SectorCache;    /* the sector cache */
  26. uint SectorFree;                /* next unused slot */
  27. *SectorCache_t SectorHead;            /* head of LRU chain */
  28. *SectorCache_t SectorTail;            /* tail of LRU chain */
  29.  
  30. [SHIP_CACHE_SIZE] ShipCache_t ShipCache;
  31. uint ShipFree;
  32. *ShipCache_t ShipHead, ShipTail;
  33.  
  34. file(OS_BLOCK_SIZE * 1) SectorFile;        /* yes, ONE disk block */
  35. file(OS_BLOCK_SIZE * 1) ShipFile;
  36. file(OS_BLOCK_SIZE * 1) TelegramFile;
  37. file(OS_BLOCK_SIZE * 1) FleetFile;
  38. file(OS_BLOCK_SIZE * 1) LoanFile;
  39. file(OS_BLOCK_SIZE * 1) OfferFile;
  40. file() NewsFile;
  41. channel input binary SectorIn;
  42. channel output binary SectorOut;
  43. channel input binary ShipIn;
  44. channel output binary ShipOut;
  45. channel input binary TelegramIn;
  46. channel output binary TelegramOut;
  47. channel input binary FleetIn;
  48. channel output binary FleetOut;
  49. channel input binary LoanIn;
  50. channel output binary LoanOut;
  51. channel input binary OfferIn;
  52. channel output binary OfferOut;
  53. channel input binary NewsIn;
  54. channel output binary NewsOut;
  55. uint Receiver;                /* receiver of open telegram */
  56.  
  57. /*
  58.  * closeEmpireFile - do the actual file closing.
  59.  */
  60.  
  61. proc closeEmpireFile()void:
  62.  
  63.     close(OfferOut);
  64.     close(OfferIn);
  65.     close(LoanOut);
  66.     close(LoanIn);
  67.     close(FleetOut);
  68.     close(FleetIn);
  69.     close(ShipOut);
  70.     close(ShipIn);
  71.     close(SectorOut);
  72.     close(SectorIn);
  73. corp;
  74.  
  75. /*
  76.  * abort - abort with a message.
  77.  */
  78.  
  79. proc abort(*char message)void:
  80.  
  81.     writeln(Chout; "*** ", message, " - aborting");
  82.     if UsingSerial then
  83.     writeln("*** ", message, " - aborting");
  84.     fi;
  85.     closeEmpireFile();
  86.     if SerialOpen then
  87.     closeSerialHandler();
  88.     fi;
  89.     writeln(LogChannel; "*** ABORT: ", message);
  90.     close(LogChannel);
  91.     exit(1);
  92. corp;
  93.  
  94. /*
  95.  * sectorFlush - flush the sector cache. We flush the sectors in increasing
  96.  *    absolute sector order, so as to minimize disk seeking.
  97.  */
  98.  
  99. proc sectorFlush()void:
  100.     uint minRow, minCol, i;
  101.     bool foundDirty;
  102.     *SectorCache_t lowest, sc;
  103.  
  104.     if SectorFree ~= 0 then
  105.     while
  106.         foundDirty := false;
  107.         minRow := 0xffff;
  108.         minCol := 0xffff;
  109.         sc := &SectorCache[0];
  110.         for i from 0 upto SectorFree - 1 do
  111.         if sc*.sc_dirty and
  112.             (sc*.sc_row < minRow or
  113.              sc*.sc_row = minRow and
  114.                  sc*.sc_col < minCol) then
  115.             foundDirty := true;
  116.             lowest := sc;
  117.             minRow := sc*.sc_row;
  118.             minCol := sc*.sc_col;
  119.         fi;
  120.         sc := sc + sizeof(SectorCache_t);
  121.         od;
  122.         foundDirty
  123.     do
  124.         if not SeekOut(SectorOut, sizeof(World_t) +
  125.                COUNTRY_MAX * sizeof(Country_t) +
  126.                (make(minRow, ulong) * World.w_columns + minCol) *
  127.                 sizeof(Sector_t))
  128.         then
  129.         abort("Can't seek to sector");
  130.         fi;
  131.         if not write(SectorOut; lowest*.sc_sector) then
  132.         abort("Can't write sector");
  133.         fi;
  134.         lowest*.sc_dirty := false;
  135.     od;
  136.     fi;
  137. corp;
  138.  
  139. /*
  140.  * sectorLookup - lookup/enter the requested sector in the sector cache.
  141.  *    Return 'false' if it was already there. Referencing it will always
  142.  *    put it at the head of the chain.
  143.  */
  144.  
  145. proc sectorLookup(uint r, c)bool:
  146.     uint dirtyCount;
  147.     *SectorCache_t sc;
  148.  
  149.     sc := SectorHead;
  150.     while sc ~= nil and
  151.         (sc*.sc_row ~= r or sc*.sc_col ~= c) do
  152.     sc := sc*.sc_next;
  153.     od;
  154.     if sc = nil then
  155.     /* didn't find the needed sector - add it to the cache. */
  156.     if SectorFree ~= SECTOR_CACHE_SIZE then
  157.         /* free slot left - just use it */
  158.         sc := &SectorCache[SectorFree];
  159.         SectorFree := SectorFree + 1;
  160.     else
  161.         /* no free slot - look for a non-dirty one */
  162.         dirtyCount := 0;
  163.         sc := SectorTail;
  164.         while sc ~= nil and sc*.sc_dirty do
  165.         sc := sc*.sc_prev;
  166.         dirtyCount := dirtyCount + 1;
  167.         od;
  168.         if dirtyCount > SECTOR_CACHE_SIZE * 4 / 5 or sc = nil then
  169.         /* no non-dirty slot left. Flush all and use tail one. */
  170.         sectorFlush();
  171.         sc := SectorTail;
  172.         fi;
  173.         /* delete the sector from it's current position in the chain */
  174.         if sc*.sc_prev = nil then
  175.         SectorHead := sc*.sc_next;
  176.         else
  177.         sc*.sc_prev*.sc_next := sc*.sc_next;
  178.         fi;
  179.         if sc*.sc_next = nil then
  180.         SectorTail := sc*.sc_prev;
  181.         else
  182.         sc*.sc_next*.sc_prev := sc*.sc_prev;
  183.         fi;
  184.     fi;
  185.     /* insert it at the head of the chain */
  186.     sc*.sc_prev := nil;
  187.     sc*.sc_next := SectorHead;
  188.     if SectorHead ~= nil then
  189.         SectorHead*.sc_prev := sc;
  190.     else
  191.         SectorTail := sc;
  192.     fi;
  193.     SectorHead := sc;
  194.     /* set it to be the requested sector */
  195.     sc*.sc_row := r;
  196.     sc*.sc_col := c;
  197.     sc*.sc_dirty := false;
  198.     true
  199.     else
  200.     /* move it to the front of the LRU chain if its not there already */
  201.     if sc*.sc_prev ~= nil then
  202.         sc*.sc_prev*.sc_next := sc*.sc_next;
  203.         if sc*.sc_next ~= nil then
  204.         sc*.sc_next*.sc_prev := sc*.sc_prev;
  205.         else
  206.         SectorTail := sc*.sc_prev;
  207.         fi;
  208.         sc*.sc_prev := nil;
  209.         sc*.sc_next := SectorHead;
  210.         if SectorHead ~= nil then
  211.         SectorHead*.sc_prev := sc;
  212.         else
  213.         SectorTail := sc;
  214.         fi;
  215.         SectorHead := sc;
  216.     fi;
  217.     false
  218.     fi
  219. corp;
  220.  
  221. /*
  222.  * shipFlush - flush the ship cache. We flush the ships in increasing
  223.  *    ship number order, so as to minimize disk seeking.
  224.  */
  225.  
  226. proc shipFlush()void:
  227.     uint minNum, i;
  228.     bool foundDirty;
  229.     *ShipCache_t lowest, shc;
  230.  
  231.     if ShipFree ~= 0 then
  232.     while
  233.         foundDirty := false;
  234.         minNum := 0xffff;
  235.         shc := &ShipCache[0];
  236.         for i from 0 upto ShipFree - 1 do
  237.         if shc*.shc_dirty and shc*.shc_shipNumber < minNum then
  238.             foundDirty := true;
  239.             lowest := shc;
  240.             minNum := shc*.shc_shipNumber;
  241.         fi;
  242.         shc := shc + sizeof(ShipCache_t);
  243.         od;
  244.         foundDirty
  245.     do
  246.         if not SeekOut(ShipOut, make(minNum, ulong) * sizeof(Ship_t)) then
  247.         abort("Can't seek to ship");
  248.         fi;
  249.         if not write(ShipOut; lowest*.shc_ship) then
  250.         abort("Can't write ship");
  251.         fi;
  252.         lowest*.shc_dirty := false;
  253.     od;
  254.     fi;
  255. corp;
  256.  
  257. /*
  258.  * shipLookup - lookup/enter the requested ship in the ship cache.
  259.  *    Return 'false' if it was already there. Referencing it will always
  260.  *    put it at the head of the chain.
  261.  */
  262.  
  263. proc shipLookup(uint shipNumber)bool:
  264.     uint dirtyCount;
  265.     *ShipCache_t shc;
  266.  
  267.     shc := ShipHead;
  268.     while shc ~= nil and shc*.shc_shipNumber ~= shipNumber do
  269.     shc := shc*.shc_next;
  270.     od;
  271.     if shc = nil then
  272.     /* didn't find the needed sector - add it to the cache. */
  273.     if ShipFree ~= SHIP_CACHE_SIZE then
  274.         /* free slot left - just use it */
  275.         shc := &ShipCache[ShipFree];
  276.         ShipFree := ShipFree + 1;
  277.     else
  278.         /* no free slot - look for a non-dirty one */
  279.         dirtyCount := 0;
  280.         shc := ShipTail;
  281.         while shc ~= nil and shc*.shc_dirty do
  282.         shc := shc*.shc_prev;
  283.         dirtyCount := dirtyCount + 1;
  284.         od;
  285.         if dirtyCount > SHIP_CACHE_SIZE * 4 / 5 or shc = nil then
  286.         /* no non-dirty slot left. Flush all and use tail one. */
  287.         shipFlush();
  288.         shc := ShipTail;
  289.         fi;
  290.         /* delete the ship from it's current position in the chain */
  291.         if shc*.shc_prev = nil then
  292.         ShipHead := shc*.shc_next;
  293.         else
  294.         shc*.shc_prev*.shc_next := shc*.shc_next;
  295.         fi;
  296.         if shc*.shc_next = nil then
  297.         ShipTail := shc*.shc_prev;
  298.         else
  299.         shc*.shc_next*.shc_prev := shc*.shc_prev;
  300.         fi;
  301.     fi;
  302.     /* insert it at the head of the chain */
  303.     shc*.shc_prev := nil;
  304.     shc*.shc_next := ShipHead;
  305.     if ShipHead ~= nil then
  306.         ShipHead*.shc_prev := shc;
  307.     else
  308.         ShipTail := shc;
  309.     fi;
  310.     ShipHead := shc;
  311.     /* set it to be the requested ship */
  312.     shc*.shc_shipNumber := shipNumber;
  313.     shc*.shc_dirty := false;
  314.     true
  315.     else
  316.     /* move it to the front of the LRU chain if its not there already */
  317.     if shc*.shc_prev ~= nil then
  318.         shc*.shc_prev*.shc_next := shc*.shc_next;
  319.         if shc*.shc_next ~= nil then
  320.         shc*.shc_next*.shc_prev := shc*.shc_prev;
  321.         else
  322.         ShipTail := shc*.shc_prev;
  323.         fi;
  324.         shc*.shc_prev := nil;
  325.         shc*.shc_next := ShipHead;
  326.         if ShipHead ~= nil then
  327.         ShipHead*.shc_prev := shc;
  328.         else
  329.         ShipTail := shc;
  330.         fi;
  331.         ShipHead := shc;
  332.     fi;
  333.     false
  334.     fi
  335. corp;
  336.  
  337. /*
  338.  * closeFile - flush and close the empire data files.
  339.  */
  340.  
  341. proc closeFile()void:
  342.  
  343.     sectorFlush();
  344.     shipFlush();
  345.     closeEmpireFile();
  346. corp;
  347.  
  348. /*
  349.  * openAbort - early abort when opening files.
  350.  */
  351.  
  352. proc openAbort(*char which)void:
  353.  
  354.     writeln(Chout; "*** can't open empire ", which, " file - aborting");
  355.     writeln(LogChannel; "*** can't open empire ", which, " file - aborting");
  356.     close(LogChannel);
  357.     if SerialOpen then
  358.     closeSerialHandler();
  359.     fi;
  360.     exit(1);
  361. corp;
  362.  
  363. /*
  364.  * openFile - open the empire data files.
  365.  */
  366.  
  367. proc openFile()void:
  368.  
  369.     if not open(SectorIn, SectorFile, SECTOR_FILE) then
  370.     openAbort("sector");
  371.     fi;
  372.     ReOpen(SectorIn, SectorOut);
  373.     SectorFree := 0;
  374.     SectorHead := nil;
  375.     SectorTail := nil;
  376.     if not open(ShipIn, ShipFile, SHIP_FILE) then
  377.     close(SectorOut);
  378.     close(SectorIn);
  379.     openAbort("ship");
  380.     fi;
  381.     ReOpen(ShipIn, ShipOut);
  382.     ShipFree := 0;
  383.     ShipHead := nil;
  384.     ShipTail := nil;
  385.     if not open(FleetIn, FleetFile, FLEET_FILE) then
  386.     close(ShipOut);
  387.     close(ShipIn);
  388.     close(SectorOut);
  389.     close(SectorIn);
  390.     openAbort("fleet");
  391.     fi;
  392.     ReOpen(FleetIn, FleetOut);
  393.     if not open(LoanIn, LoanFile, LOAN_FILE) then
  394.     close(ShipOut);
  395.     close(ShipIn);
  396.     close(SectorOut);
  397.     close(SectorIn);
  398.     close(FleetOut);
  399.     close(FleetIn);
  400.     openAbort("loan");
  401.     fi;
  402.     ReOpen(LoanIn, LoanOut);
  403.     if not open(OfferIn, OfferFile, OFFER_FILE) then
  404.     close(ShipOut);
  405.     close(ShipIn);
  406.     close(SectorOut);
  407.     close(SectorIn);
  408.     close(FleetOut);
  409.     close(FleetIn);
  410.     close(LoanOut);
  411.     close(LoanIn);
  412.     openAbort("offer");
  413.     fi;
  414.     ReOpen(OfferIn, OfferOut);
  415. corp;
  416.  
  417. /*
  418.  * readWorld - read the world header and user information
  419.  */
  420.  
  421. proc readWorld()void:
  422.  
  423.     if not SeekOut(SectorOut, 0) then
  424.     abort("Can't seek to header");
  425.     fi;
  426.     if not read(SectorIn; World) then
  427.     abort("Can't read world size");
  428.     fi;
  429.     if not read(SectorIn; Country) then
  430.     abort("Can't read users");
  431.     fi;
  432. corp;
  433.  
  434. /*
  435.  * writeWorld - write the world header and user information
  436.  */
  437.  
  438. proc writeWorld()void:
  439.  
  440.     if not SeekOut(SectorOut, 0) then
  441.     abort("Can't seek to header");
  442.     fi;
  443.     if not write(SectorOut; World) then
  444.     abort("Can't write world size");
  445.     fi;
  446.     if not write(SectorOut; Country) then
  447.     abort("Can't write users");
  448.     fi;
  449. corp;
  450.  
  451. /*
  452.  * readSector - read the given sector into a given buffer.
  453.  */
  454.  
  455. proc readSector(int row, col; Sector_t s)void:
  456.  
  457.     if sectorLookup(transRow(row), transCol(col)) then
  458.     if not SeekOut(SectorOut, sizeof(World_t) +
  459.         COUNTRY_MAX * sizeof(Country_t) +
  460.         (make(transRow(row), ulong) * World.w_columns +
  461.             transCol(col)) * sizeof(Sector_t)) then
  462.         abort("Can't seek to sector");
  463.     fi;
  464.     if not read(SectorIn; SectorHead*.sc_sector) then
  465.         abort("Can't read sector");
  466.     fi;
  467.     fi;
  468.     s := SectorHead*.sc_sector;
  469. corp;
  470.  
  471. /*
  472.  * writeSector - write the given sector from a given buffer.
  473.  */
  474.  
  475. proc writeSector(int row, col; Sector_t s)void:
  476.  
  477.     pretend(sectorLookup(transRow(row), transCol(col)), void);
  478.     SectorHead*.sc_sector := s;
  479.     SectorHead*.sc_dirty := true;
  480. corp;
  481.  
  482. /*
  483.  * readShip - read the given ship into a given buffer.
  484.  */
  485.  
  486. proc readShip(uint shipNumber; Ship_t ship)void:
  487.  
  488.     if shipLookup(shipNumber) then
  489.     if not SeekOut(ShipOut, make(shipNumber, ulong) * sizeof(Ship_t)) then
  490.         abort("Can't seek to ship");
  491.     fi;
  492.     if not read(ShipIn; ShipHead*.shc_ship) then
  493.         abort("Can't read ship");
  494.     fi;
  495.     fi;
  496.     ship := ShipHead*.shc_ship;
  497. corp;
  498.  
  499. /*
  500.  * writeShip - write the given ship from a given buffer.
  501.  */
  502.  
  503. proc writeShip(uint shipNumber; Ship_t ship)void:
  504.  
  505.     pretend(shipLookup(shipNumber), void);
  506.     ShipHead*.shc_ship := ship;
  507.     ShipHead*.shc_dirty := true;
  508. corp;
  509.  
  510. /*
  511.  * readFleet - read the given fleet into a given buffer.
  512.  */
  513.  
  514. proc readFleet(uint fleetNumber; Fleet_t fleet)void:
  515.  
  516.     if not SeekOut(FleetOut, make(fleetNumber, ulong) * sizeof(Fleet_t)) then
  517.     abort("Can't seek to fleet");
  518.     fi;
  519.     if not read(FleetIn; fleet) then
  520.     abort("Can't read fleet");
  521.     fi;
  522. corp;
  523.  
  524. /*
  525.  * writeFleet - write the given fleet from a given buffer.
  526.  */
  527.  
  528. proc writeFleet(uint fleetNumber; Fleet_t fleet)void:
  529.  
  530.     if not SeekOut(FleetOut, make(fleetNumber, ulong) * sizeof(Fleet_t)) then
  531.     abort("Can't seek to fleet");
  532.     fi;
  533.     if not write(FleetOut; fleet) then
  534.     abort("Can't write fleet");
  535.     fi;
  536. corp;
  537.  
  538. /*
  539.  * readLoan - read the given loan into a given buffer.
  540.  */
  541.  
  542. proc readLoan(uint loanNumber; Loan_t loan)void:
  543.  
  544.     if not SeekOut(LoanOut, make(loanNumber, ulong) * sizeof(Loan_t)) then
  545.     abort("Can't seek to loan");
  546.     fi;
  547.     if not read(LoanIn; loan) then
  548.     abort("Can't read loan");
  549.     fi;
  550. corp;
  551.  
  552. /*
  553.  * writeLoan - write the given loan from a given buffer.
  554.  */
  555.  
  556. proc writeLoan(uint loanNumber; Loan_t loan)void:
  557.  
  558.     if not SeekOut(LoanOut, make(loanNumber, ulong) * sizeof(Loan_t)) then
  559.     abort("Can't seek to loan");
  560.     fi;
  561.     if not write(LoanOut; loan) then
  562.     abort("Can't write loan");
  563.     fi;
  564. corp;
  565.  
  566. /*
  567.  * readOffer - read the given offer into a given buffer.
  568.  */
  569.  
  570. proc readOffer(uint offerNumber; Offer_t offer)void:
  571.  
  572.     if not SeekOut(OfferOut, make(offerNumber, ulong) * sizeof(Offer_t)) then
  573.     abort("Can't seek to offer");
  574.     fi;
  575.     if not read(OfferIn; offer) then
  576.     abort("Can't read offer");
  577.     fi;
  578. corp;
  579.  
  580. /*
  581.  * writeOffer - write the given offer from a given buffer.
  582.  */
  583.  
  584. proc writeOffer(uint offerNumber; Offer_t offer)void:
  585.  
  586.     if not SeekOut(OfferOut, make(offerNumber, ulong) * sizeof(Offer_t)) then
  587.     abort("Can't seek to offer");
  588.     fi;
  589.     if not write(OfferOut; offer) then
  590.     abort("Can't write offer");
  591.     fi;
  592. corp;
  593.  
  594. /*
  595.  * telegramChar - write a character to the current telegram.
  596.  */
  597.  
  598. proc telegramChar(char ch)void:
  599.  
  600.     write(TelegramOut; ch);
  601.     Country[Receiver].c_telegramsTail := Country[Receiver].c_telegramsTail + 1;
  602. corp;
  603.  
  604. /*
  605.  * telegramStart - start the transmission of a telegram.
  606.  */
  607.  
  608. proc telegramStart(uint sender, receiver)void:
  609.     *char p;
  610.     ulong ul;
  611.  
  612.     p := "telegrams.XX";
  613.     (p + 10)* := receiver / 10 + '0';
  614.     (p + 11)* := receiver % 10 + '0';
  615.     if not open(TelegramOut, TelegramFile, p) then
  616.     abort("Can't open telegram file");
  617.     fi;
  618.     RandomOut(TelegramOut);
  619.     if Country[receiver].c_telegramsTail ~= 0 and
  620.         not SeekOut(TelegramOut, Country[receiver].c_telegramsTail) then
  621.     close(TelegramOut);
  622.     abort("can't seek to add telegram");
  623.     fi;
  624.     Receiver := receiver;
  625.     write(TelegramOut; sender);
  626.     ul := CurrentTime();
  627.     write(TelegramOut; ul);
  628.     Country[receiver].c_telegramsTail := Country[receiver].c_telegramsTail +
  629.         (sizeof(uint) + sizeof(ulong));
  630.     open(TelegramChannel, telegramChar);
  631. corp;
  632.  
  633. /*
  634.  * telegramEnd - end the current telegram.
  635.  */
  636.  
  637. proc telegramEnd()void:
  638.  
  639.     close(TelegramChannel);
  640.     close(TelegramOut);
  641. corp;
  642.  
  643. /*
  644.  * telegramOpen - open this user's telegram file for reading.
  645.  */
  646.  
  647. proc telegramOpen()void:
  648.     *char p;
  649.  
  650.     p := "telegrams.XX";
  651.     (p + 10)* := ThisCountryNumber / 10 + '0';
  652.     (p + 11)* := ThisCountryNumber % 10 + '0';
  653.     if not open(TelegramIn, TelegramFile, p) then
  654.     abort("Can't open telegram file");
  655.     fi;
  656. corp;
  657.  
  658. /*
  659.  * telegramRead - read the next telegram and return the number of bytes read.
  660.  *    Return '0' and close the file when there are no more to read.
  661.  */
  662.  
  663. proc telegramRead(ulong endPosition)bool:
  664.     ulong time;
  665.     uint sender;
  666.     byte b;
  667.  
  668.     if GetIn(TelegramIn) ~= endPosition and read(TelegramIn; sender, time) then
  669.     writeln(Chout;);
  670.     write(Chout; "Telegram from ", &Country[sender].c_name[0], " dated ");
  671.     writeDate(time);
  672.     writeln(Chout; ':');
  673.     writeln(Chout;);
  674.     while read(TelegramIn; b) and b ~= 0 do
  675.         write(Chout; b + '\e');
  676.     od;
  677.     writeln(Chout;);
  678.     true
  679.     else
  680.     close(TelegramIn);
  681.     false
  682.     fi
  683. corp;
  684.  
  685. /*
  686.  * getNewsFileName - fill in a file name for news for the given time's day.
  687.  */
  688.  
  689. proc getNewsFileName(*char buffer; ulong time)void:
  690.     channel output text dateChannel;
  691.  
  692.     open(dateChannel, buffer);
  693.     write(dateChannel; "news.", time / (60 * 60 * 24));
  694.     close(dateChannel);
  695. corp;
  696.  
  697. /*
  698.  * news - add a news item to today's news file.
  699.  */
  700.  
  701. proc news(NewsType_t verb; uint actor, victim)void:
  702.     News_t n;
  703.     ulong now, position;
  704.     [15] char fileName;
  705.  
  706.     now := CurrentTime();
  707.     n.n_verb := verb;
  708.     n.n_actor := actor;
  709.     n.n_victim := victim;
  710.     n.n_btu := Country[actor].c_btu;
  711.     n.n_time := now;
  712.     getNewsFileName(&fileName[0], now);
  713.     if not open(NewsOut, NewsFile, &fileName[0]) then
  714.     if not FileCreate(&fileName[0]) then
  715.         abort("can't create news file to add news");
  716.     fi;
  717.     if not open(NewsOut, NewsFile, &fileName[0]) then
  718.         abort("can't open news file to add news");
  719.     fi;
  720.     fi;
  721.     RandomOut(NewsOut);
  722.     position := GetOutMax(NewsOut);
  723.     if not SeekOut(NewsOut, position) then
  724.     close(NewsOut);
  725.     abort("can't seek to add news");
  726.     fi;
  727.     write(NewsOut; n);
  728.     close(NewsOut);
  729. corp;
  730.  
  731. /*
  732.  * newsOpen - open a news file to read the whole contents.
  733.  *    Return 'false' if none.
  734.  */
  735.  
  736. proc newsOpen(ulong date)bool:
  737.     [15] char fileName;
  738.  
  739.     getNewsFileName(&fileName[0], date);
  740.     if open(NewsIn, NewsFile, &fileName[0]) then
  741.     true
  742.     else
  743.     false
  744.     fi
  745. corp;
  746.  
  747. /*
  748.  * newsNext - read the next news chunk from the current file.
  749.  *    Close the file and return 'false' when none left.
  750.  */
  751.  
  752. proc newsNext(News_t n)bool:
  753.  
  754.     if read(NewsIn; n) then
  755.     true
  756.     else
  757.     close(NewsIn);
  758.     false
  759.     fi
  760. corp;
  761.